VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Holiday"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Private Const hSunday = 1, hSaturday = 2

Enum hType
    hNERC
    hLoadForecast
    hNYMEX
End Enum
Public Function DayType(TestDate As Date, Optional CalendarType As hType = hNERC)

    DayType = DayofWeek(TestDate, CalendarType)

End Function
Public Function DayofWeek(TestDate As Date, Optional CalendarType As hType = hLoadForecast) As Long

    Dim iMonth As Long, iDay As Long, DOW As Long
    iMonth = Month(TestDate)
    iDay = Day(TestDate)
    DOW = Weekday(TestDate)
    DayofWeek = DOW
    
    Select Case CalendarType
    
    Case hLoadForecast:
        ''  New Year's Day (January 1st)
        If (iMonth = 1 And iDay = 1) Then DayofWeek = vbSunday: Exit Function
        ''  New Year's Day (January 1st) falls on Saturday
        If (iMonth = 12 And iDay = 31 And DOW = vbFriday) Then DayofWeek = vbSunday: Exit Function
        ''  New Year's Day (January 1st) falls on Sunday
        If (iMonth = 1 And iDay = 2 And DOW = vbMonday) Then DayofWeek = vbSunday: Exit Function
''          ''  MLK Birthday (3rd Monday in January)
''          if (iMonth == Calendar.JANUARY && d.get(Calendar.DAY_OF_WEEK) == Calendar.MONDAY && d.get(Calendar.WEEK_OF_MONTH) == 3) return Calendar.SATURDAY;
''          ''  Washington's Birthday (3rd Monday in February)
''          if (iMonth == Calendar.FEBRUARY && d.get(Calendar.DAY_OF_WEEK) == Calendar.MONDAY && d.get(Calendar.WEEK_OF_MONTH) == 3) return Calendar.SATURDAY;
''          ''  Good Friday
''          GregorianCalendar E = (GregorianCalendar)d.clone();
''          E.add(Calendar.DATE,2);
''          if (isEaster(E)) return Calendar.SATURDAY;
        If (iMonth < 5) Then DayofWeek = DOW: Exit Function
        ''  Memorial Day (Last Monday in May)
        If (iMonth = 5 And DOW = vbMonday And iDay >= 25) Then DayofWeek = vbSunday: Exit Function
        If (iMonth < 7) Then DayofWeek = DOW: Exit Function
        ''  Independence Day (July 4th)
        If (iMonth = 7 And iDay = 4) Then DayofWeek = vbSunday: Exit Function
        ''  Independence Day (July 4th) falls on Saturday
        If (iMonth = 7 And iDay = 3 And DOW = vbFriday) Then DayofWeek = vbSunday: Exit Function
        ''  Independence Day (July 4th) falls on Sunday
        If (iMonth = 7 And iDay = 5 And DOW = vbMonday) Then DayofWeek = vbSunday: Exit Function
        If (iMonth < 9) Then DayofWeek = DOW: Exit Function
        ''  Labor Day (1st Monday in September)
        If (iMonth = 9 And DOW = vbMonday And iDay <= 7) Then DayofWeek = vbSunday: Exit Function
''          ''  Columbus Day (2nd Monday in October)
''          if (iMonth == Calendar.OCTOBER && d.get(Calendar.DATE) == Calendar.MONDAY && d.get(Calendar.DAY_OF_WEEK_IN_MONTH) == 2) return Calendar.SATURDAY;
''          ''  Veterns Day (November 11th)
''          if (iMonth == Calendar.NOVEMBER && iDay == 11) return Calendar.SATURDAY;
        If (iMonth < 11) Then DayofWeek = DOW: Exit Function
        ''  Thanksgiving Day (4th Thursday in November)
        If (iMonth = 11 And DOW = vbThursday And WeekInMonth(TestDate) = 4) Then DayofWeek = vbSunday: Exit Function
        ''  Day After Thanksgiving (4th Friday in November) The Day After Thanksgiving is still guaranteed to be in November
        If (iMonth = 11 And DOW = vbFriday And WeekInMonth(TestDate) = 4) Then DayofWeek = vbSaturday: Exit Function
        ''  Christmas Eve (December 24th) falls on Saturday
        If (iMonth = 12 And iDay = 23 And DOW = vbFriday) Then DayofWeek = vbSaturday: Exit Function
        ''  Christmas Eve (December 24th)
        If (iMonth = 12 And iDay = 24) Then DayofWeek = vbSaturday: Exit Function
        ''  Christmas Day (December 25th)
        If (iMonth = 12 And iDay = 25) Then DayofWeek = vbSunday: Exit Function
        ''  Christmas Day (December 25th) falls on Sunday
        If (iMonth = 12 And iDay = 26 And DOW = vbMonday) Then DayofWeek = vbSunday: Exit Function
    Case hType.hNYMEX:
        ''  New Year's Day (January 1st)
        If (iMonth = 1 And iDay = 1) Then DayofWeek = vbSunday: Exit Function
        ''  New Year's Day (January 1st) falls on Saturday
        If (iMonth = 12 And iDay = 31 And DOW = vbFriday) Then DayofWeek = vbSunday: Exit Function
        ''  New Year's Day (January 1st) falls on Sunday
        If (iMonth = 1 And iDay = 2 And DOW = vbMonday) Then DayofWeek = vbSunday: Exit Function
        ''  MLK Birthday (3rd Monday in January)
        If (iMonth = 1 And DOW = vbMonday And WeekInMonth(TestDate) = 3) Then DayofWeek = vbSunday: Exit Function
        ''  Washington's Birthday (3rd Monday in February)
        If (iMonth = 2 And DOW = vbMonday And WeekInMonth(TestDate) = 3) Then DayofWeek = vbSunday: Exit Function
        If (iMonth < 5) Then Exit Function
        ''  Memorial Day (Last Monday in May)
        If (iMonth = 5 And DOW = vbMonday And iDay >= 25) Then DayofWeek = vbSunday: Exit Function
        If (iMonth < 7) Then Exit Function
        ''  Independence Day (July 4th)
        If (iMonth = 7 And iDay = 4) Then DayofWeek = vbSunday: Exit Function
        ''  Independence Day (July 4th) falls on Saturday
        If (iMonth = 7 And iDay = 3 And DOW = vbFriday) Then DayofWeek = vbSunday: Exit Function
        ''  Independence Day (July 4th) falls on Sunday
        If (iMonth = 7 And iDay = 5 And DOW = vbMonday) Then DayofWeek = vbSunday: Exit Function
        If (iMonth < 9) Then Exit Function
        ''  Labor Day (1st Monday in September)
        If (iMonth = 9 And DOW = vbMonday And iDay <= 7) Then DayofWeek = vbSunday: Exit Function
        ''  Columbus Day (2nd Monday in October)
        If (iMonth = 10 And DOW = vbMonday And WeekInMonth(TestDate) = 2) Then DayofWeek = vbSaturday: Exit Function
        If (iMonth < 11) Then Exit Function
        ''  Veterns Day (November 11th)
        If (iMonth = 11 And iDay = 11) Then DayofWeek = vbSaturday: Exit Function
        ''  Thanksgiving Day (4th Thursday in November)
        If (iMonth = 11 And DOW = vbThursday And WeekInMonth(TestDate) = 4) Then DayofWeek = vbSunday: Exit Function
        ''  Day After Thanksgiving (4th Friday in November) The Day After Thanksgiving is still guaranteed to be in November
        If (iMonth = 11 And DOW = vbFriday And WeekInMonth(TestDate) = 4) Then DayofWeek = vbSaturday: Exit Function
        ''  Christmas Eve (December 24th) falls on Saturday
        If (iMonth = 12 And iDay = 23 And DOW = vbFriday) Then DayofWeek = vbSaturday: Exit Function
        ''  Christmas Eve (December 24th)
        If (iMonth = 12 And iDay = 24) Then DayofWeek = vbSaturday: Exit Function
        ''  Christmas Day (December 25th)
        If (iMonth = 12 And iDay = 25) Then DayofWeek = vbSunday: Exit Function
        ''  Christmas Day (December 25th) falls on Sunday
        If (iMonth = 12 And iDay = 26 And DOW = vbMonday) Then DayofWeek = vbSunday: Exit Function
    Case hType.hNERC:
        ''  New Year's Day (January 1st)
        If (iMonth = 1 And iDay = 1) Then DayofWeek = vbSunday: Exit Function
        ''  New Year's Day (January 1st) falls on Saturday
        If (iMonth = 12 And iDay = 31 And DOW = vbFriday) Then DayofWeek = vbSunday: Exit Function
        ''  New Year's Day (January 1st) falls on Sunday
        If (iMonth = 1 And iDay = 2 And DOW = vbMonday) Then DayofWeek = vbSunday: Exit Function
        If (iMonth < 5) Then Exit Function
        ''  Memorial Day (Last Monday in May)
        If (iMonth = 5 And DOW = vbMonday And iDay >= 25) Then DayofWeek = vbSunday: Exit Function
        If (iMonth < 7) Then Exit Function
        ''  Independence Day (July 4th)
        If (iMonth = 7 And iDay = 4) Then DayofWeek = vbSunday: Exit Function
        ''  Independence Day (July 4th) falls on Saturday
        If (iMonth = 7 And iDay = 3 And DOW = vbFriday) Then DayofWeek = vbSunday: Exit Function
        ''  Independence Day (July 4th) falls on Sunday
        If (iMonth = 7 And iDay = 5 And DOW = vbMonday) Then DayofWeek = vbSunday: Exit Function
        If (iMonth < 9) Then Exit Function
        ''  Labor Day (1st Monday in September)
        If (iMonth = 9 And DOW = vbMonday And iDay <= 7) Then DayofWeek = vbSunday: Exit Function
        If (iMonth < 11) Then Exit Function
        ''  Thanksgiving Day (4th Thursday in November)
        If (iMonth = 11 And DOW = vbThursday And WeekInMonth(TestDate) = 4) Then DayofWeek = vbSunday: Exit Function
        ''  Day After Thanksgiving (4th Friday in November) The Day After Thanksgiving is still guaranteed to be in November
        If (iMonth = 11 And DOW = vbFriday And WeekInMonth(TestDate) = 4) Then DayofWeek = vbSaturday: Exit Function
        ''  Christmas Eve (December 24th) falls on Saturday
        If (iMonth = 12 And iDay = 23 And DOW = vbFriday) Then DayofWeek = vbSaturday: Exit Function
        ''  Christmas Eve (December 24th)
        If (iMonth = 12 And iDay = 24) Then DayofWeek = vbSaturday: Exit Function
        ''  Christmas Day (December 25th)
        If (iMonth = 12 And iDay = 25) Then DayofWeek = vbSunday: Exit Function
        ''  Christmas Day (December 25th) falls on Sunday
        If (iMonth = 12 And iDay = 26 And DOW = vbMonday) Then DayofWeek = vbSunday: Exit Function
    End Select

End Function
Private Function WeekInMonth(TestDate As Date)

    WeekInMonth = (Day(TestDate) - 1) \ 7 + 1

End Function
Private Function GetEasterDate(pintYear As Integer) As Date

    Dim c           As Integer
    Dim N           As Integer
    Dim k           As Integer
    Dim i           As Integer
    Dim j           As Integer
    Dim L           As Integer
    Dim intMonth    As Integer
    Dim intDay      As Integer
    
    c = pintYear \ 100
    N = pintYear - 19 * (pintYear \ 19)
    k = (c - 17) \ 25
    i = c - c \ 4 - (c - k) \ 3 + 19 * N + 15
    i = i - 30 * (i \ 30)
    i = i - (i \ 28) * (1 - (i \ 28) * (29 \ (i + 1)) * ((21 - N) \ 11))
    j = pintYear + pintYear \ 4 + i + 2 - c + c \ 4
    j = j - 7 * (j \ 7)
    L = i - j
    intMonth = 3 + (L + 40) \ 44
    intDay = L + 28 - 31 * (intMonth \ 4)
    
    GetEasterDate = DateSerial(pintYear, intMonth, intDay)

End Function
Public Function DSTAdjustment(StudyDate As Date) As Date
    On Error GoTo DSTAdjustment_Error
    
    If (Date >= #1/1/2007#) Then
        'Determine if Daylight Savings Time is active: between 2:00 AM on the first Sunday in April, and 2:00 AM on the
        'last Sunday in October
        Select Case Month(StudyDate)
        Case 1, 2, 12
            DSTAdjustment = StudyDate
        Case 4, 5, 6, 7, 8, 9, 10
            DSTAdjustment = StudyDate - 1 / 24
        Case 11
            DSTAdjustment = StudyDate
            If Day(StudyDate) < Weekday(StudyDate) Then DSTAdjustment = StudyDate - 1 / 24
        Case 3
            DSTAdjustment = StudyDate - 1 / 24
            If Day(StudyDate) < 15 Or Day(StudyDate) - 14 < Weekday(StudyDate) Then DSTAdjustment = StudyDate
        End Select
    Else
        'Determine if Daylight Savings Time is active: between 2:00 AM on the first Sunday in April, and 2:00 AM on the
        'last Sunday in October
        Select Case Month(StudyDate)
        Case 1, 2, 3, 11, 12
            DSTAdjustment = StudyDate
        Case 5, 6, 7, 8, 9
            DSTAdjustment = StudyDate - 1 / 24
        Case 4
            DSTAdjustment = StudyDate - 1 / 24
            If Day(StudyDate) < Weekday(StudyDate) Then DSTAdjustment = StudyDate
        Case 10
            DSTAdjustment = StudyDate
            If Day(StudyDate) < 25 Or Day(StudyDate) - 24 < Weekday(StudyDate) Then DSTAdjustment = StudyDate - 1 / 24
        End Select
    End If
Exit Function
DSTAdjustment_Error:
    Err.Raise Err.Number, "DSTAdjustment: " & Err.Source, Err.Description
End Function

Public Function DaysPerMonth(StudyDate As Date) As Integer
    On Error GoTo DaysPerMonth_Error
' Returns the number of days in a month
    Select Case Month(StudyDate)
    Case 1, 3, 5, 7, 8, 10, 12
        DaysPerMonth = 31
    Case 4, 6, 9, 11
        DaysPerMonth = 30
    Case 2
        If Year(StudyDate) Mod 4 = 0 Then
            DaysPerMonth = 29
        Else
            DaysPerMonth = 28
        End If
    End Select
Exit Function
DaysPerMonth_Error:
    Err.Raise Err.Number, "DaysPerMonth: " & Err.Source, Err.Description
End Function

Function IsLeapYear(ByVal Year As Integer) As Boolean
On Error GoTo ErrorOut

    IsLeapYear = False
    If Year Mod 4 = 0 Then
        IsLeapYear = True
        If Year Mod 100 = 0 And Year Mod 400 <> 0 Then
            IsLeapYear = False
        End If
    End If

    Exit Function
    
ErrorOut:
    Err.Raise Err.Number, "IsLeapYear: " & Err.Source, Err.Description
End Function

Public Function NetTradeDays(StartDate As Date, EndDate As Date) As Long
    On Error GoTo NetTradeDays_Error
    Dim i As Date, DT As Integer
    
    NetTradeDays = 0
    For i = StartDate + 1 To EndDate
        DT = DayType(i, hNERC)
        If DT > 1 And DT < 7 Then NetTradeDays = NetTradeDays + 1
    Next i
Exit Function
NetTradeDays_Error:
    Err.Raise Err.Number, "NetTradeDays: " & Err.Source, Err.Description
End Function
